home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1998 May: Tool Chest / Dev.CD May 98 TC.toast / Tool Chest / Development Kits / HyperCard Related / APDA HyperCard Toolkits / HyperCard CTB Toolkit 1.0b2 / Source Code / CTBSendWithLF.p < prev    next >
Encoding:
Text File  |  1995-02-07  |  2.6 KB  |  114 lines  |  [TEXT/MPS ]
  1. (*
  2.     CTBSendWithLF string[,eom] -- Send a string out the current connection, adding linefeeds after every
  3.         carriage return in the string. If the eom parameter is present and non-empty, then set the
  4.         end-of-message bit when sending.
  5.  
  6.     To compile and link this file using Macintosh Programmer's Workshop,
  7.  
  8.         pascal -w CTBSendWithLF.p
  9.         link -m ENTRYPOINT -o HyperCommands -rt XCMD=2765 -sn Main=CTBSendWithLF ∂
  10.             CTBSendWithLF.p.o "{MPW}"Libraries:interface.o "{MPW}"Libraries:Libraries:HyperXLib.o
  11.  
  12.     © Copyright 1990 by Apple Computer, Inc.
  13.  
  14.     Initial coding 2/90 by Harry R. Chesley.
  15. *)
  16.  
  17. {$R-}
  18.  
  19. {$S CTBSendWithLF }     { Segment name must be the same as the command name. }
  20.  
  21. unit DummyUnit;
  22.  
  23. interface
  24.  
  25. uses MemTypes, QuickDraw, OSIntf, ToolIntf, CTBUtils, FTIntf, CMIntf, TMIntf, CRMIntf, HyperXCmd;
  26.  
  27. procedure EntryPoint(paramPtr: XCmdPtr);
  28.     
  29. implementation
  30.  
  31. procedure CTBSendWithLF(paramPtr: XCmdPtr); forward;
  32.  
  33. procedure EntryPoint(paramPtr: XCmdPtr);
  34.  
  35.     begin
  36.         CTBSendWithLF(paramPtr);
  37.     end;
  38.  
  39. procedure CTBSendWithLF(paramPtr: XCmdPtr);
  40.  
  41.     {$I CTBUtil.inc}
  42.  
  43.     const linefeed = 10;            { ASCII for line feed. }
  44.         return = 13;                    { ASCII for carriage return. }
  45.  
  46.     var i: integer;
  47.         flags: CMFlags;
  48.         p, p2: Ptr;
  49.         newP: Ptr;
  50.         l: longInt;
  51.         h: Handle;
  52.         err: CMErr;
  53.  
  54.     procedure Fail(errMsg: Str255); { set theResult and quit }
  55.         begin
  56.             paramPtr^.returnValue := PasToZero(paramPtr,errMsg);
  57.             exit(CTBSendWithLF);
  58.         end;
  59.  
  60.     begin
  61.         { Check the parameter count. }
  62.         i := paramPtr^.paramCount;
  63.         if (i = 0) or (i > 2) then Fail('Invalid parameter count');
  64.  
  65.         { Check for an empty string being sent. }
  66.         if not ParmPresent(1) then exit(CTBSendWithLF);
  67.         h := paramPtr^.params[1];
  68.  
  69.         { Make sure the Comm Toolbox is here. }
  70.         CTBReady;
  71.         { And a connection tool is available. }
  72.         EnsurePresent(connectionTool);
  73.         { And it's open. }
  74.         EnsureOpen;
  75.  
  76.         { Figure out if we should set the EOM flag. }
  77.         if ParmPresent(2) then flags := cmFlagsEOM
  78.         else flags := 0;
  79.  
  80.         { Count the bytes, adding in space for the linefeeds. }
  81.         l := 0;
  82.         p := h^;
  83.         while p^ <> 0 do
  84.             begin
  85.                 if p^ = return then l := l+1;
  86.                 p := Ptr(ord4(p)+1);
  87.                 l := l+1;
  88.             end;
  89.  
  90.         { Allocate a new pointer for the modified input. }
  91.         newP := NewPtr(l);
  92.         if newP = nil then Fail('Could not allocate memory for write');
  93.         { Copy it in, adding linefeeds. }
  94.         p := h^;
  95.         p2 := newP;
  96.         while p^ <> 0 do
  97.             begin
  98.                 p2^ := p^;
  99.                 p2 := Ptr(ord4(p2)+1);
  100.                 if p^ = return then
  101.                     begin
  102.                         p2^ := linefeed;
  103.                         p2 := Ptr(ord4(p2)+1);
  104.                     end;
  105.                 p := Ptr(ord4(p)+1);
  106.             end;
  107.         { Write it out. }
  108.         err := CMWrite(Globals^^.connHand,newP,l,cmData,false,nil,-1,flags);
  109.         DisposPtr(newP);
  110.         if err <> noErr then Fail('Write failed');
  111.     end;
  112.  
  113. end.
  114.